home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / gcl-1.0-l / gcl-1 / usr / local / lib / gcl-1.0 / doc / dbl.el < prev    next >
Encoding:
Text File  |  1994-05-10  |  15.8 KB  |  479 lines
  1. ;; Run gcl under Emacs
  2. ;; Author: W. Schelter, University of Texas
  3. ;;     wfs@rascal.ics.utexas.edu
  4.  
  5. ;; This file is part of GNU Emacs.
  6. ;; Copyright (C) 1988 Free Software Foundation, Inc.
  7.  
  8. ;; GNU Emacs is distributed in the hope that it will be useful, but
  9. ;; WITHOUT ANY WARRANTY.  No author or distributor accepts responsibility
  10. ;; to anyone for the consequences of using it or for whether it serves
  11. ;; any particular purpose or works at all, unless he says so in writing.
  12. ;; Refer to the GNU Emacs General Public License for full details.
  13.  
  14. ;; Everyone is granted permission to copy, modify and redistribute GNU
  15. ;; Emacs, but only under the conditions described in the GNU Emacs
  16. ;; General Public License.  A copy of this license is supposed to have
  17. ;; been given to you along with GNU Emacs so you can know your rights and
  18. ;; responsibilities.  It should be in a file named COPYING.  Among other
  19. ;; things, the copyright notice and this notice must be preserved on all
  20. ;; copies.
  21.  
  22. ;; Description of DBL interface:
  23.  
  24. ;; A facility is provided for the simultaneous display of the source code
  25. ;; in one window, while using dbl to step through a function in the
  26. ;; other.  A small arrow in the source window, indicates the current
  27. ;; line.
  28.  
  29. ;; Starting up:
  30.  
  31. ;; In order to use this facility, invoke the command DBL to obtain a
  32. ;; shell window with the appropriate command bindings.  You will be asked
  33. ;; for the name of a file to run.  Dbl will be invoked on this file, in a
  34. ;; window named *dbl-foo* if the file is foo.
  35.  
  36. ;; M-s steps by one line, and redisplays the source file and line.
  37.  
  38. ;; You may easily create additional commands and bindings to interact
  39. ;; with the display.  For example to put the dbl command next on \M-n
  40. ;; (def-dbl next "\M-n")
  41.  
  42. ;; This causes the emacs command dbl-next to be defined, and runs
  43. ;; dbl-display-frame after the command.
  44.  
  45. ;; dbl-display-frame is the basic display function.  It tries to display
  46. ;; in the other window, the file and line corresponding to the current
  47. ;; position in the dbl window.  For example after a dbl-step, it would
  48. ;; display the line corresponding to the position for the last step.  Or
  49. ;; if you have done a backtrace in the dbl buffer, and move the cursor
  50. ;; into one of the frames, it would display the position corresponding to
  51. ;; that frame.
  52.  
  53. ;; dbl-display-frame is invoked automatically when a filename-and-line-number
  54. ;; appears in the output.
  55.  
  56.  
  57. (require 'sshell)
  58. (require 'gcl)
  59.  
  60. (defvar dbl-prompt-pattern "\\(^(.*gdb[+]*) *\\)\\|\\(^[^#$%>]*[#$%>]+ *\\)"
  61.   "A regexp to recognize the prompt for dbl or dbl+.") 
  62.  
  63. (defvar dbl-mode-map nil
  64.   "Keymap for dbl-mode.")
  65.  
  66. (if dbl-mode-map
  67.    nil
  68.   (setq dbl-mode-map (copy-keymap shell-mode-map))
  69.   (define-key dbl-mode-map "\C-cl" 'dbl-find-line)
  70.   )
  71.  
  72. (define-key ctl-x-map " " 'dbl-break)
  73. ;(define-key ctl-x-map "&" 'send-dbl-command)
  74.  
  75. ;;Of course you may use `def-dbl' with any other dbl command, including
  76. ;;user defined ones.   
  77.  
  78. (defmacro def-dbl (name key &optional doc)
  79.   (let* ((fun (intern (format "dbl-%s" name)))
  80.      (cstr (list 'if '(not (= 1 arg))
  81.              (list 'format "%s %s" name 'arg)
  82.              name)))
  83.     (list 'progn
  84.        (list 'defun fun '(arg)
  85.         (or doc "")
  86.         '(interactive "p")
  87.         (list 'dbl-call cstr))
  88.       (list 'define-key 'dbl-mode-map key  (list 'quote fun)))))
  89.  
  90. (def-dbl ":step"   "\M-s" "Step one source line with display")
  91. (def-dbl ":step"  "\M-i" "Step one instruction with display")
  92. (def-dbl ":next"   "\M-n" "Step one source line (skip functions)")
  93. (def-dbl ":r"   "\M-c" "Continue with display")
  94.  
  95. (def-dbl "finish" "\C-c\C-f" "Finish executing current function")
  96. (def-dbl ":up"     "\M-u"   "Go up N stack frames (numeric arg) with display")
  97. (def-dbl ":down"   "\M-d"   "Go down N stack frames (numeric arg) with display")
  98.  
  99.  
  100. (defun dbl-mode ()
  101.   "Major mode for interacting with an inferior Dbl process.
  102. The following commands are available:
  103.  
  104. \\{dbl-mode-map}
  105.  
  106. \\[dbl-display-frame] displays in the other window
  107. the last line referred to in the dbl buffer.
  108.  
  109. \\[dbl-:step] and \\[dbl-:next] in the dbl window,
  110. call dbl to step and next and then update the other window
  111. with the current file and position.
  112.  
  113. If you are in a source file, you may select a point to break
  114. at, by doing \\[dbl-break].
  115.  
  116. Commands:
  117. Many commands are inherited from shell mode. 
  118. Additionally we have:
  119.  
  120. \\[dbl-display-frame] display frames file in other window
  121. \\[dbl-:step] advance one line in program
  122. \\[dbl-:next] advance one line in program (skip over calls).
  123. \\[send-dbl-command] used for special printing of an arg at the current point.
  124. C-x SPACE sets break point at current line."
  125.   (interactive)
  126.   (kill-all-local-variables)
  127.   (setq major-mode 'dbl-mode)
  128.   (setq mode-name "Inferior Dbl")
  129.   (setq mode-line-process '(": %s"))
  130.   (use-local-map dbl-mode-map)
  131.   (make-local-variable 'last-input-start)
  132.   (setq last-input-start (make-marker))
  133.   (make-local-variable 'last-input-end)
  134.   (setq last-input-end (make-marker))
  135.   (make-local-variable 'dbl-last-frame)
  136.   (setq dbl-last-frame nil)
  137.   (make-local-variable 'dbl-last-frame-displayed-p)
  138.   (setq dbl-last-frame-displayed-p t)
  139.   (make-local-variable 'dbl-delete-prompt-marker)
  140.   (setq dbl-delete-prompt-marker nil)
  141.   (make-local-variable 'dbl-filter-accumulator)
  142.   (setq dbl-filter-accumulator nil)
  143.   (make-local-variable 'shell-prompt-pattern)
  144.   (setq shell-prompt-pattern dbl-prompt-pattern)
  145.   (run-hooks 'shell-mode-hook 'dbl-mode-hook))
  146.  
  147. (defvar current-dbl-buffer nil)
  148.  
  149. (defvar dbl-command-name "/bin/csh"
  150.   "Pathname for executing dbl.")
  151.  
  152.  
  153. (defun dbl (arg)
  154.   " makes a dbl buffer, suitable for running an inferior gcl.
  155.  It has special keybindings for stepping and viewing sources.
  156.  Once in the buffer invoke the lisp.   Enter the debug loop with
  157.  (si::dbl) or :dbl in a debug loop.
  158. " (interactive "sName: ")
  159.   (let ((file arg) tem
  160.     (dir default-directory))
  161.     (switch-to-buffer (concat "*dbl-" file "*"))
  162.     (setq default-directory
  163.       (if (and (setq tem (file-name-directory file))
  164.            (file-directory-p  tem))
  165.           tem    dir))
  166.     (or (bolp) (newline))
  167.     (insert "Current directory is " default-directory "\n")
  168.     (make-shell (concat "dbl-" file) dbl-command-name nil )
  169.     (dbl-mode)
  170.     (set-process-filter (get-buffer-process (current-buffer)) 'dbl-filter)
  171.     (set-process-sentinel (get-buffer-process (current-buffer)) 'dbl-sentinel)
  172.     (dbl-set-buffer)))
  173.  
  174. (defun dbl-set-buffer ()
  175.   (cond ((eq major-mode 'dbl-mode)
  176.     (setq current-dbl-buffer (current-buffer)))))
  177.  
  178. ;; This function is responsible for inserting output from DBL
  179. ;; into the buffer.
  180. ;; Aside from inserting the text, it notices and deletes
  181. ;; each filename-and-line-number;
  182. ;; that DBL prints to identify the selected frame.
  183. ;; It records the filename and line number, and maybe displays that file.
  184. (defun dbl-filter (proc string)
  185.   (let ((inhibit-quit t))
  186.     (if dbl-filter-accumulator
  187.     (dbl-filter-accumulate-marker proc
  188.                       (concat dbl-filter-accumulator string))
  189.     (dbl-filter-scan-input proc string))))
  190.  
  191. (defun dbl-filter-accumulate-marker (proc string)
  192.   (setq dbl-filter-accumulator nil)
  193.   (if (> (length string) 1)
  194.       (if (= (aref string 1) ?\032)
  195.       (let ((end (string-match "\n" string)))
  196.         (if end
  197.         (progn
  198.           (let* ((first-colon (string-match ":" string 2))
  199.              (second-colon
  200.               (string-match ":" string (1+ first-colon))))
  201.             (setq dbl-last-frame
  202.               (cons (substring string 2 first-colon)
  203.                 (string-to-int
  204.                  (substring string (1+ first-colon)
  205.                         second-colon)))))
  206.           (setq dbl-last-frame-displayed-p nil)
  207.           (dbl-filter-scan-input proc
  208.                      (substring string (1+ end))))
  209.           (setq dbl-filter-accumulator string)))
  210.     (dbl-filter-insert proc "\032")
  211.     (dbl-filter-scan-input proc (substring string 1)))
  212.     (setq dbl-filter-accumulator string)))
  213.  
  214. (defun dbl-filter-scan-input (proc string)
  215.   (if (equal string "")
  216.       (setq dbl-filter-accumulator nil)
  217.       (let ((start (string-match "\032" string)))
  218.     (if start
  219.         (progn (dbl-filter-insert proc (substring string 0 start))
  220.            (dbl-filter-accumulate-marker proc
  221.                          (substring string start)))
  222.         (dbl-filter-insert proc string)))))
  223.  
  224. (defun dbl-filter-insert (proc string)
  225.   (let ((moving (= (point) (process-mark proc)))
  226.     (output-after-point (< (point) (process-mark proc)))
  227.     (old-buffer (current-buffer))
  228.     start)
  229.     (set-buffer (process-buffer proc))
  230.     (unwind-protect
  231.     (save-excursion
  232.       ;; Insert the text, moving the process-marker.
  233.       (goto-char (process-mark proc))
  234.       (setq start (point))
  235.       (insert string)
  236.       (set-marker (process-mark proc) (point))
  237.       (dbl-maybe-delete-prompt)
  238.       ;; Check for a filename-and-line number.
  239.       (dbl-display-frame
  240.        ;; Don't display the specified file
  241.        ;; unless (1) point is at or after the position where output appears
  242.        ;; and (2) this buffer is on the screen.
  243.        (or output-after-point
  244.            (not (get-buffer-window (current-buffer))))
  245.        ;; Display a file only when a new filename-and-line-number appears.
  246.        t)
  247.       (goto-char (point-max))
  248.  
  249.       )
  250.       (set-buffer old-buffer))
  251.     (if moving (goto-char (process-mark proc)))))
  252. (setq me nil)
  253. (defun dbl-sentinel (proc msg)
  254.   (cond ((null (buffer-name (process-buffer proc)))
  255.      ;; buffer killed
  256.      ;; Stop displaying an arrow in a source file.
  257.      (setq overlay-arrow-position nil)
  258.      (set-process-buffer proc nil))
  259.     ((memq (process-status proc) '(signal exit))
  260.      ;; Stop displaying an arrow in a source file.
  261.      (setq overlay-arrow-position nil)
  262.      ;; Fix the mode line.
  263.      (setq mode-line-process
  264.            (concat ": "
  265.                (symbol-name (process-status proc))))
  266.      (let* ((obuf (current-buffer)))
  267.        ;; save-excursion isn't the right thing if
  268.        ;;  process-buffer is current-buffer
  269.        (unwind-protect
  270.            (progn
  271.          ;; Write something in *compilation* and hack its mode line,
  272.          (set-buffer (process-buffer proc))
  273.          ;; Force mode line redisplay soon
  274.          (set-buffer-modified-p (buffer-modified-p))
  275.          (if (eobp)
  276.              (insert ?\n mode-name " " msg)
  277.            (save-excursion
  278.              (goto-char (point-max))
  279.              (insert ?\n mode-name " " msg)))
  280.          ;; If buffer and mode line will show that the process
  281.          ;; is dead, we can delete it now.  Otherwise it
  282.          ;; will stay around until M-x list-processes.
  283.          (delete-process proc))
  284.          ;; Restore old buffer, but don't restore old point
  285.          ;; if obuf is the dbl buffer.
  286.          (set-buffer obuf))))))
  287.  
  288.  
  289. (defun dbl-refresh ()
  290.   "Fix up a possibly garbled display, and redraw the arrow."
  291.   (interactive)
  292.   (redraw-display)
  293.   (dbl-display-frame))
  294.  
  295. (defun dbl-display-frame (&optional nodisplay noauto)
  296.   "Find, obey and delete the last filename-and-line marker from DBL.
  297. The marker looks like \\032\\032FILENAME:LINE:CHARPOS\\n.
  298. Obeying it means displaying in another window the specified file and line."
  299.   (interactive)
  300.   (dbl-set-buffer)
  301.   (and dbl-last-frame (not nodisplay)
  302.        (or (not dbl-last-frame-displayed-p) (not noauto))
  303.        (progn (dbl-display-line (car dbl-last-frame) (cdr dbl-last-frame))
  304.           (setq dbl-last-frame-displayed-p t))))
  305.  
  306.          
  307. ;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen
  308. ;; and that its line LINE is visible.
  309. ;; Put the overlay-arrow on the line LINE in that buffer.
  310.  
  311.  
  312.  
  313. (defun dbl-find-file (file)
  314.   (cond ((file-exists-p file)
  315.      (find-file-noselect file))
  316.     ((get-buffer file))
  317.     (t (find-file-noselect file))))
  318.  
  319. (defvar dbl-dirs  nil)
  320.  
  321. (defun search-path (file dirs)
  322.   (let ((paths (symbol-value dirs))
  323.     true-file)
  324.     (cond ((file-exists-p file) (setq true-file file))
  325.       (t
  326.        (while paths
  327.          (let ((tem (expand-file-name file (or (car paths) default-directory))))
  328.            (if  (file-exists-p tem) (setq true-file tem))
  329.            (setq paths (cdr paths))))))
  330.    
  331.    (cond (true-file)
  332.      (t (setq paths (symbol-value dirs))
  333.       (set dirs
  334.           (append paths
  335.               (list (file-name-directory
  336.                  (read-file-name
  337.                   (format "%s = %s, add path :" dirs paths))))))
  338.          (search-path file dirs)))))
  339.  
  340. (defun dbl-find-line ()
  341.   (interactive)
  342.   (save-excursion
  343.     (end-of-line)
  344.     (cond ((re-search-backward "[a-zA-Z] line [0-9]+)" 300 nil)
  345.        (let (at)  
  346.          (setq at (point))
  347.          (forward-char 1)
  348.          (forward-sexp 1)
  349.          (setq line (read (current-buffer)))
  350.          (search-backward "(")
  351.          (setq file  (buffer-substring (+ 1 (point)) (+ 1 at)))
  352.          (and (integerp line)
  353.           (setq file (search-path file 'dbl-dirs))
  354.           (dbl-display-line
  355.            file line)))))))
  356.            
  357.     
  358. (defun dbl-display-line (true-file line)
  359.   (let* ((buffer (dbl-find-file true-file))
  360.      (window (display-buffer buffer t))
  361.      (pos))
  362.     (save-excursion
  363.       (set-buffer buffer)
  364.       (save-restriction
  365.     (widen)
  366.     (goto-line line)
  367.     (setq pos (point))
  368.     (setq overlay-arrow-string "=>")
  369.     (or overlay-arrow-position
  370.         (setq overlay-arrow-position (make-marker)))
  371.     (set-marker overlay-arrow-position (point) (current-buffer)))
  372.       (cond ((or (< pos (point-min)) (> pos (point-max)))
  373.          (widen)
  374.          (goto-char pos))))
  375.     (set-window-point window overlay-arrow-position)))
  376.  
  377. (defun dbl-call (command)
  378.   "Invoke dbl COMMAND displaying source in other window."
  379.   (interactive)
  380.   (goto-char (point-max))
  381.   (setq dbl-delete-prompt-marker (point-marker))
  382.   (dbl-set-buffer)
  383.   (send-string (get-buffer-process current-dbl-buffer)
  384.            (concat command "\n")))
  385.  
  386. (defun dbl-maybe-delete-prompt ()
  387.   (if (and dbl-delete-prompt-marker
  388.        (> (point-max) (marker-position dbl-delete-prompt-marker)))
  389.       (let (start)
  390.     (goto-char dbl-delete-prompt-marker)
  391.     (setq start (point))
  392.     (beginning-of-line)
  393.     (delete-region (point) start)
  394.     (setq dbl-delete-prompt-marker nil))))
  395.  
  396. (defun dbl-break ()
  397.   "Set DBL breakpoint at this source line."
  398.   (interactive)
  399.   (cond ((eq major-mode 'lisp-mode)
  400.      (save-excursion
  401.        (end-of-line)
  402.        (let (name
  403.          at where)
  404.          (setq where (point))
  405.          (mark-defun)
  406.          (search-forward "(def")
  407.          (forward-sexp 2)
  408.          (setq at (point))
  409.          (forward-sexp -1)
  410.          (setq name (buffer-substring (point) at))
  411.          (beginning-of-line)
  412. ;         (setq at
  413. ;           (progn (re-search-forward "^[^;\"\n]+([a-zA-Z ]" (mark) t)
  414. ;              (forward-char -2)
  415. ;              (point)))
  416.          (setq name (format "(si::break-function '%s %s t)"  name (count-lines 1 where)))
  417.          (other-window 1)
  418.          (if (get-buffer-process (current-buffer))
  419.          (setq current-dbl-buffer (current-buffer)))
  420.          (other-window 1)
  421.          (message name)
  422.          (send-string (get-buffer-process current-dbl-buffer)
  423.               (concat name "\n")))))
  424.     (t
  425.   
  426.      (let ((file-name (file-name-nondirectory buffer-file-name))
  427.            (line (save-restriction
  428.                (widen)
  429.                (1+ (count-lines 1 (point))))))
  430.        (send-string (get-buffer-process current-dbl-buffer)
  431.             (concat "break " file-name ":" line "\n"))))))
  432.     
  433.     
  434. (defun dbl-read-address()
  435.   "Return a string containing the core-address found in the buffer at point."
  436.   (save-excursion
  437.    (let ((pt (dot)) found begin)
  438.      (setq found (if (search-backward "0x" (- pt 7) t)(dot)))
  439.      (cond (found (forward-char 2)(setq result
  440.             (buffer-substring found
  441.                  (progn (re-search-forward "[^0-9a-f]")
  442.                     (forward-char -1)
  443.                     (dot)))))
  444.        (t (setq begin (progn (re-search-backward "[^0-9]") (forward-char 1)
  445.                  (dot)))
  446.           (forward-char 1)
  447.           (re-search-forward "[^0-9]")
  448.           (forward-char -1)
  449.           (buffer-substring begin (dot)))))))
  450.  
  451.  
  452. (defvar dbl-commands nil
  453.   "List of strings or functions used by send-dbl-command.
  454. It is for customization by you.")
  455.  
  456. (defun send-dbl-command (arg)
  457.  
  458.   "This command reads the number where the cursor is positioned.  It
  459.  then inserts this ADDR at the end of the dbl buffer.  A numeric arg
  460.  selects the ARG'th member COMMAND of the list dbl-print-command.  If
  461.  COMMAND is a string, (format COMMAND ADDR) is inserted, otherwise
  462.  (funcall COMMAND ADDR) is inserted.  eg. \"p (rtx)%s->fld[0].rtint\"
  463.  is a possible string to be a member of dbl-commands.  "
  464.  
  465.  
  466.   (interactive "P")
  467.   (let (comm addr)
  468.     (if arg (setq comm (nth arg dbl-commands)))
  469.     (setq addr (dbl-read-address))
  470.     (if (eq (current-buffer) current-dbl-buffer)
  471.     (set-mark (point)))
  472.     (cond (comm
  473.        (setq comm
  474.          (if (stringp comm) (format comm addr) (funcall comm addr))))
  475.       (t (setq comm addr)))
  476.     (switch-to-buffer current-dbl-buffer)
  477.     (goto-char (dot-max))
  478.     (insert-string comm)))
  479.